home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE12 / TIPTRIX / LISTINGS.PAS
Encoding:
Pascal/Delphi Source File  |  1996-07-27  |  2.9 KB  |  100 lines
  1. { Tips & Tricks Issue 12 }
  2.  
  3. {LISTING 1}
  4. ...
  5. type
  6.   EThunkError = class(Exception);
  7.  
  8. initialization
  9.   if Win32Platform <> Ver_Platform_Win32_Windows then
  10.     raise EThunkError.Create('Flat thunks only supported under Windows 95');
  11. end.
  12.  
  13.  
  14. {LISTING 2}
  15. procedure TFMain.CreateShow(const TFClass : TFormClass; var Reference);
  16. begin
  17.   TForm(Reference) := TFClass.create(application);
  18.   try
  19.     TForm(Reference).showmodal;
  20.   finally
  21.     TForm(Reference).free;
  22.   end;
  23. end;
  24.  
  25.  
  26. {LISTING 3}
  27. uses SysUtils;
  28.  
  29. function DirExists(Dir : string) : boolean;
  30.   var fRec : TSearchRec;
  31. begin
  32.   if (Dir[ Length(Dir) ] = '\') then
  33.     Dec(Dir[0]);         { No '\' at the end }
  34.  
  35.   case Length(Dir) of
  36.     0, 1 : Result := false; { Error }
  37.     2    : Result := (Dir[2] = ':') and
  38.                      (DiskFree(Ord(Dir[1])-64) <> -1);    { Root directory }
  39.   else
  40.     Result := (FindFirst(Dir, faDirectory, fRec) = 0);       { Directory }
  41.     FindClose(fRec);
  42.   end;
  43. end;
  44. ----------------------------------------------------------------------
  45.  
  46.  
  47. {LISTING 4}
  48. uses WinTypes, WinProcs, ToolHelp;
  49.  
  50. procedure ExecuteAndWait(Command : string);
  51.   var
  52.     ModuleID  : THandle;
  53.     TaskEntry : TTaskEntry;
  54.     TaskCount : integer;
  55.     TaskList  : array [1..100] of THandle;  { More than 100 tasks ??? }
  56.     i         : integer;
  57. begin
  58.   TaskEntry.dwSize := SizeOf(TTaskEntry);    { Has to be initalized }
  59.   TaskCount := 0;
  60.   if TaskFirst(@TaskEntry) then              { Save list of active tasks }
  61.     repeat
  62.       Inc(TaskCount);
  63.       TaskList[TaskCount] := TaskEntry.hTask;
  64.     until (not TaskNext(@TaskEntry));
  65.   Command := Command + #0;
  66.   ModuleID := WinExec(@Command[1], SW_SHOWNOACTIVATE);         { Execute }
  67.   if (ModuleID <= hInstance_Error) then
  68.                   { Error, Report the error }
  69.   else
  70.     if TaskFirst(@TaskEntry) then    { Search for new task }
  71.       repeat
  72.         if (TaskEntry.hModule = ModuleID) then    { Task uses same module }
  73.           for i := 1 to TaskCount do
  74.             { Search through list }
  75.             if (TaskList[i] <> TaskEntry.hTask) then begin
  76.               { Found }
  77.               repeat
  78.                 { Wait for termination }
  79.                 Application.ProcessMessages;
  80.               until (not IsTask(TaskEntry.hTask)) or Application.Terminated;
  81.               exit;
  82.             end;
  83.       until (not TaskNext(@TaskEntry));
  84. end;
  85. ----------------------------------------------------------------------
  86.  
  87.  
  88. {LISTING 5}
  89. procedure TF_Main.DetailGridDrawDataCell(Sender: TObject;
  90.   const Rect: TRect; Field: TField; State: TGridDrawState);
  91. begin
  92.   If DetailTable.FieldByName('Row Index').AsInteger In [1,7,8,14] Then
  93.     With (Sender as TDBGrid).Canvas Do
  94.       Begin
  95.         If gdSelected in State Then Brush.Color:=clGreen  {further hilite cell}
  96.           Else Brush.Color:=clAqua;   {highlight for weekends}
  97.       End;
  98.   DetailGrid.DefaultDrawDataCell(Rect,Field,State);
  99. end;
  100.